home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d26 / cattest.arc / INITGRAD.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-01  |  5KB  |  184 lines

  1. {$A+,B-,D+,E+,F-,I+,L+,N-,O-,R-,S+,V+}
  2. {$M 16384,0,655360}
  3.  
  4. PROGRAM Init_Gradebook;
  5. {v1.1 uuencode from Toad Hall Tweak, 9 May 90
  6.  - Converted reserved, other word case to my preferred style.
  7.  - Converted for Turbo Pascal v5.0 compilation ("Uses", etc.)
  8.  
  9.  - Program reads password from sysin, writes a temp file with it
  10.    in ASCII, then uuencodes it into a file called GRADES.BK$.
  11. }
  12. Uses Dos,Crt;
  13.  
  14. CONST  {uue}
  15.     OFFSET = 32;
  16.     Header = 'begin';
  17.     Trailer = 'end';
  18.     DefaultMode = '644';
  19.     DefaultExtension = '.uue';
  20.     CHARSPERLINE = 60;
  21.     BYTESPERHUNK = 3;
  22.     SIXBITMASK = $3F;
  23.  
  24. TYPE 
  25.   Str80 = STRING[80];
  26.  
  27. VAR
  28.   InFile_2 : TEXT;
  29.   Infile: FILE OF Byte;
  30.   TempFile,
  31.   Outfile: TEXT;
  32.   Outfilename, Mode: Str80;
  33.   lineLength, numbytes, bytesInLine: INTEGER;
  34.   Line_uud : Str80;
  35.   Line: ARRAY [0..59] OF CHAR;
  36.   hunk: ARRAY [0..2] OF Byte;
  37.   chars: ARRAY [0..3] OF Byte;
  38.   size,remaining : longint;  {v1.1 REAL;}
  39. CONST
  40.   TempFileName = 'PASSWORD.TMP';
  41.   UUencoded_GRADE_file = 'GRADE.BK$';
  42.  
  43. VAR
  44.   Password : STRING;
  45.   Ch : Char;
  46.  
  47. PROCEDURE Abort (Msg : Str80);
  48.   BEGIN
  49.     WRITELN(Msg);
  50.     {$I-}                 {v1.1}
  51.     CLOSE(Infile);
  52.     CLOSE(Outfile);
  53.     {$I+}                 {v1.1}
  54.     HALT
  55.   END; {of Abort}
  56. PROCEDURE FlushLine;
  57.  
  58.   VAR i: INTEGER;
  59.  
  60.   PROCEDURE WriteOut(Ch: CHAR);
  61.     BEGIN
  62.       IF Ch = ' '
  63.         THEN WRITE(Outfile, '`')
  64.                   ELSE WRITE(Outfile, Ch)
  65.     END; {of WriteOut}
  66.   BEGIN {FlushLine}
  67.     {write ('.');}
  68.     WRITE('bytes remaining: ',remaining:7,' (',
  69.           remaining/size*100.0:3:0,'%)',CHR(13));
  70.     WriteOut(CHR(bytesInLine + OFFSET));
  71.     FOR i := 0 TO PRED(lineLength) DO
  72.       WriteOut(Line[i]);
  73.     WRITELN (Outfile);
  74.     lineLength := 0;
  75.     bytesInLine := 0
  76.   END; {of FlushLine}
  77.  
  78. PROCEDURE FlushHunk;
  79.  
  80.   VAR i: INTEGER;
  81.   BEGIN
  82.     IF lineLength = CHARSPERLINE
  83.       THEN FlushLine;
  84.     chars[0] := hunk[0] ShR 2;
  85.     chars[1] := (hunk[0] ShL 4) + (hunk[1] ShR 4);
  86.     chars[2] := (hunk[1] ShL 2) + (hunk[2] ShR 6);
  87.     chars[3] := hunk[2] AND SIXBITMASK;
  88.     {debug;}
  89.     FOR i := 0 TO 3 DO
  90.       BEGIN
  91.         Line[lineLength] := CHR((chars[i] AND SIXBITMASK) + OFFSET);
  92.       {write(line[linelength]:2);}
  93.         Inc(lineLength);
  94.       END;
  95.     {writeln;}
  96.     Inc(bytesInLine,numbytes);
  97.     numbytes := 0
  98.   END; {of FlushHunk}
  99.  
  100. PROCEDURE Encode1;
  101.   BEGIN
  102.     IF numbytes = BYTESPERHUNK
  103.       THEN FlushHunk;
  104.     READ (Infile, hunk[numbytes]);
  105.     Dec(remaining);
  106.     Inc(numbytes);
  107.   END; {of Encode1}
  108.   BEGIN {Init_Gradebook}
  109.       ClrScr;
  110.       {$I-}
  111.       ASSIGN (TempFile, TempFileName ); {temp grade file, to be erased}
  112.       REWRITE (Tempfile);
  113.       {$I+}
  114.       WriteLn('Enter the desired password (less than 10 chars).');
  115.       ReadLn(Password);
  116.       WriteLn(TempFile,Password);
  117.       Close(Tempfile);
  118.  
  119.       {$I-}
  120.       ASSIGN (Infile, TempFileName ); {temp grade file, to be erased}
  121.       RESET (Infile);
  122.       {$I+}
  123.       IF IOResult > 0
  124.         THEN Abort (CONCAT ('Can''t open file ', Tempfilename));
  125.       size := FileSize(Infile);
  126. {     IF size < 0 THEN size:=size+65536.0; }
  127.       remaining := size;
  128.       WRITE('Uuencoding file ', Tempfilename);
  129.       Mode := DefaultMode;
  130.       { Process 2d cmdline arg (if any).
  131.         It could be a new mode (rather than default "644")
  132.         or it could be a forced output name (rather than
  133.         "infile.uue")
  134.       }
  135.       ASSIGN (Outfile,UUencoded_GRADE_file);
  136.       WRITELN (' to file ', UUencoded_GRADE_file, '.');
  137.       {$I-}
  138.       RESET(Outfile);
  139.       {$I+}
  140.       IF IOResult = 0
  141.          THEN BEGIN          {output file exists!}
  142.                WRITE ('Overwrite current ', UUencoded_GRADE_file, '? [Y/N] ');
  143.                REPEAT
  144.                  Ch := Upcase(ReadKey);
  145.                UNTIL Ch IN ['Y', 'N'];
  146.                WRITELN (Ch);
  147.                IF Ch = 'N'
  148.                  THEN Abort(CONCAT (UUencoded_GRADE_file, ' not overwritten.'))
  149.           END;
  150.       {$I-}
  151.       CLOSE(Outfile);
  152.       IF IOResult <> 0
  153.         THEN ;  {v1.1 we don't care}
  154.       REWRITE(Outfile);
  155.       {$I+}
  156.       IF IOResult > 0
  157.         THEN Abort(CONCAT('Can''t open ', UUencoded_GRADE_file));
  158.     bytesInLine := 0;
  159.     LineLength := 0;
  160.     numbytes := 0;
  161.     WriteLn(Outfile,Header,' ',Mode,' ',UUencoded_GRADE_file);
  162.          { Force the header to reflect future name, not old name}
  163.     WHILE NOT EOF (Infile) DO
  164.     Encode1;
  165.     if numbytes > 0 then Flushhunk;
  166.     if lineLength > 0 then BEGIN
  167.       Flushline;
  168.       Flushline;
  169.     end else
  170.     flushline;
  171.     writeLn(Outfile,Trailer);
  172.  
  173.     Close(Infile);
  174.     Close(Outfile);
  175.     WRITELN('Finished uuencoding password into GRADE.BK$');
  176.     {$I-}
  177.     ASSIGN (TempFile, TempFileName ); {temp grade file, to be erased}
  178.     REWRITE (Tempfile);
  179.     Erase(TempFile);
  180.     {$I+}
  181.     IF IoResult <> 0
  182.       THEN WriteLn('Erase Failed, do it manually.');
  183.   END. {uuencode}
  184.